home *** CD-ROM | disk | FTP | other *** search
Text File | 1999-05-18 | 5.8 KB | 174 lines | [TEXT/ALFA] |
- ## -*-Tcl-*- (install)
- # ###################################################################
- # Alpha - new Tcl folder configuration
- #
- # FILE: "recentFiles.tcl"
- # created: 21/9/97 {9:14:38 pm}
- # last update: 05/18/1999 {15:01:33 PM}
- #
- # Reorganisation carried out by Vince Darley with much help from Tom
- # Fetherston, Johan Linde and suggestions from the Alpha-D mailing list.
- # Alpha is shareware; please register with the author using the register
- # button in the about box.
- #
- # original author probably Pete Keleher. Vince added a bunch of
- # code to work-around some Alpha-menu problems, and made it a
- # package.
- #
- # Version 0.2 builds the menu about a zillion times faster than
- # the original which built the menu once for every item at
- # startup! Also removed two unnecessary procs, since that stuff
- # can be done elsewhere automatically.
- # ###################################################################
- ##
-
- alpha::extension recentFilesMenu 0.3.0 {
- namespace eval recent {}
- ensureset recent::Files ""
- hook::register saveasHook recent::push
- hook::register openHook recent::push
- menu::buildProc recent recent::makeMenu
- menu::insert File submenu 2 recent
- lappend modifiedVars recent::Files
- # declare the fileset
- set "gfileSetsType(Recent Files)" "procedural"
- set "gfileSets(Recent Files)" recent::listFiles
- lunion filesetsNotInMenu "Recent Files"
- } help {Adds a menu of recent files to the files menu, and a recent files fileset}
-
- lunion varPrefs(Files) numberOfRecentFiles orderRecentFilesBy editLastUsedFile
- # The number of files to list in the 'Files->Recent' menu.
- newPref variable numberOfRecentFiles 15
- # The ordering scheme for items in the recent files menu.
- newPref variable orderRecentFilesBy 0 global recent::makeMenu [list \
- "Alphabetical Order" "Date"] index
- # Use this key binding to edit the most recently used file.
- newPref binding editLastUsedFile "" global "" recent::editLastFile
-
-
- ##
- # -------------------------------------------------------------------------
- #
- # "recent::push" --
- #
- # Works with files whose name contained '[' or ']' which didn't before.
- # Doesn't add any file which fails 'file exists' to the menu.
- # -------------------------------------------------------------------------
- ##
- proc recent::push {name {name2 ""}} {
- if {$name2 != ""} { set name $name2 }
- global recent::Files numberOfRecentFiles file::separator orderRecentFilesBy
-
- regsub { <[0-9]+>$} $name {} name
- if {![file exists $name]} { return }
- if {[info tclversion] < 8.0} {
- regsub -all {\\([][])} $name {\1} name
- # this weird search handles a variety of unusual problems with
- # Alpha's interpretation of menu items.
- if {[info exists recent::Files] \
- && ([set ind [lsearch -regexp ${recent::Files} "${file::separator}[quote::Regfind [file tail $name]]…?$"]] >= 0)} {
- set recent::Files [lreplace ${recent::Files} $ind $ind]
- lappend recent::Files $name
- if {$orderRecentFilesBy} {recent::makeMenu}
- return
- }
- } else {
- if {[info exists recent::Files] \
- && ([set ind [lsearch -exact ${recent::Files} $name]] >= 0)} {
- set recent::Files [lreplace ${recent::Files} $ind $ind]
- lappend recent::Files $name
- if {$orderRecentFilesBy} {recent::makeMenu}
- return
- }
- set ind 0
- foreach f $recent::Files {
- # perhaps we ought to test also for complications due to
- # files which end in '…'.
- if {[file tail $f] == [file tail $name]} {
- set recent::Files [lreplace ${recent::Files} $ind $ind]
- lappend recent::Files $name
- if {$orderRecentFilesBy} {recent::makeMenu}
- return
- }
- incr ind
- }
- }
-
- lappend recent::Files $name
- if {[llength ${recent::Files}] > $numberOfRecentFiles} {
- set recent::Files [lrange ${recent::Files} 1 end]
- }
- recent::makeMenu
- }
-
- proc recent::makeMenu {args} {
- global recent::Files orderRecentFilesBy
- set tails {}
- foreach t ${recent::Files} {
- lappend tails [file tail $t]
- }
- if {$orderRecentFilesBy} {
- Menu -m -c -n recent -p recent::menuProc \
- [concat [lreverse $tails] [list "(-" "Reset List"]]
- } else {
- Menu -m -c -n recent -p recent::menuProc \
- [concat [lsort -ignore $tails] [list "(-" "Reset List"]]
- }
- set enable [expr [llength ${recent::Files}] ? 1 : 0]
- enableMenuItem File recent $enable
- }
-
- ##
- # -------------------------------------------------------------------------
- #
- # "recent::menuProc" --
- #
- # Works with menu items which contain '[', ']' and '…' which didn't work
- # before.
- # -------------------------------------------------------------------------
- ##
- proc recent::menuProc {menu name} {
- global recent::Files file::separator
-
- if {$name == "Reset List"} {
- set recent::Files {}
- Menu -m -n recent -p recent::menuProc {}
- recent::makeMenu
- } else {
- if {[set ind [lsearch -regexp ${recent::Files} "${file::separator}[quote::Regfind $name]…?$"]] >= 0} {
- edit [lindex ${recent::Files} $ind]
- } else {
- # Sometime the above regexp search can have difficulties
- # due to weird chars, or file-separator confusion.
- foreach f ${recent::Files} {
- if {[file tail $f] == $name} {
- edit $f
- return
- }
- }
- dialog::errorAlert "Couldn't find a file '$name'. Weird!"
- }
- }
- }
-
- ##
- # -------------------------------------------------------------------------
- #
- # "recent::listFiles" --
- #
- # Used to retrieve the list of files in the 'recent files' fileset
- # -------------------------------------------------------------------------
- ##
- proc recent::listFiles {} {
- global recent::Files
- return ${recent::Files}
- }
-
- proc recent::editLastFile {} {
- global recent::Files
- if {[set rl [llength ${recent::Files}]]} {
- incr rl -1
- edit -c -w [lindex ${recent::Files} $rl]
- }
- }
-